home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / ftlogo.zip / HANOI.LF < prev    next >
Text File  |  1988-06-11  |  2KB  |  184 lines
  1. PPROP "FTLOGO "BURY "TRUE
  2. PPROP ".SYSTEM "BURY "TRUE
  3. TO MOVETO :POS
  4. REFRESH
  5. MOVETO1 ITEM :POS :POSLIST
  6. REFRESH
  7. END
  8.  
  9.  
  10. TO TAKE 
  11. REFRESH
  12. MOTOR 3 1
  13. REFRESH
  14. END
  15.  
  16. TO PUT 
  17. REFRESH
  18. MOTOR 3 0
  19. REFRESH
  20. END
  21.  
  22. TO MOVETO1 :X
  23. LOCAL "Y
  24. LOCAL "D
  25. LABEL "LAB
  26. REFRESH
  27. MAKE "Y ARMPOS
  28. REFRESH
  29. MAKE "D ABS (:X - :Y)
  30. REFRESH
  31. IF :D < 2 [STOP]
  32. REFRESH
  33. TEST :Y > :X
  34. REFRESH
  35. IFT [MOTOR 1 2]
  36. REFRESH
  37. IFF [MOTOR 1 1]
  38. REFRESH
  39. MAKE "Y ARMPOS
  40. REFRESH
  41. MAKE "D ABS (:X - :Y)
  42. REFRESH
  43. IF :D < 11 [MOTOR 1 0]
  44. REFRESH
  45. GO "LAB
  46. END
  47.  
  48. TO ARMPOS 
  49. OUTPUT POTI 1
  50. END
  51.  
  52. TO KEYSPOS 
  53. KEYSTO
  54. OP ARMPOS
  55. END
  56.  
  57. TO KEYSTO 
  58. LOCAL "INCHAR
  59. MAKE "INCHAR READCHAR
  60. IF :INCHAR = "S [STOP]
  61. IF OR (:INCHAR = "R) (:INCHAR = "L) [REPOSITION :INCHAR]
  62. KEYSTO
  63. END
  64.  
  65. TO REPOSITION :INCHAR
  66. IF :INCHAR = "R [MOTOR 1 1]
  67. IF :INCHAR = "L [MOTOR 1 2]
  68. WAIT 1
  69. MOTOR 1 0
  70. END
  71.  
  72. TO ABS :X
  73. IF :X > 0 [OP :X]
  74. OP -1 * :X
  75. END
  76.  
  77. TO MOVE :FROM :DEST
  78. REFRESH
  79. UP
  80. REFRESH
  81. MOVETO :FROM
  82. REFRESH
  83. DOWN
  84. RECYCLE
  85. REFRESH
  86. TAKE
  87. REFRESH
  88. UP
  89. REFRESH
  90. MOVETO :DEST
  91. REFRESH
  92. DOWN
  93. REFRESH
  94. PUT
  95. RECYCLE
  96. REFRESH
  97. UP
  98. REFRESH
  99. END
  100.  
  101. TO TOWER1 :FROM :DEST :INTERMED :HEIGHT
  102. REFRESH
  103. IF :HEIGHT = 1 [MOVE :FROM :DEST REFRESH STOP]
  104. REFRESH
  105. TOWER1 :FROM :INTERMED :DEST :HEIGHT - 1
  106. REFRESH
  107. MOVE :FROM :DEST
  108. REFRESH
  109. TOWER1 :INTERMED :DEST :FROM :HEIGHT - 1
  110. REFRESH
  111. END
  112.  
  113. TO UP 
  114. RUNTOSWITCH 2 2 2
  115. END
  116.  
  117. TO DOWN 
  118. RUNTOSWITCH 1 2 1
  119. END
  120.  
  121.  
  122. TO RUNTOSWITCH :SW :MOT :DIR 
  123. LABEL "LAB
  124. REFRESH
  125. TEST SWITCH :SW
  126. REFRESH
  127. IFT [MOTOR :MOT 0]
  128. REFRESH
  129. IFT [STOP]
  130. REFRESH
  131. MOTOR :MOT :DIR
  132. REFRESH
  133. GO "LAB
  134. END
  135.  
  136. TO START
  137. LOCAL "A 
  138. CLEARTEXT
  139. INIT
  140. UP
  141. PR [DO YOU WANT TO MARK]
  142. PR [THE TOWER POSITIONS ANEW? (Y/N)]
  143. MAKE "A RC
  144. TEST :A = "Y
  145. IFT [POSTEXT]
  146. IFT [MAKPOSLIST 3]
  147. PR []
  148. PR [HOW MANY DISKS?]
  149. MAKE "HEIGHT FIRST READLIST
  150. PR []
  151. PR [WHERE ARE THE DISKS NOW?]
  152. MAKE "FROM FIRST READLIST
  153. PR []
  154. PR [WHERE SHALL THEY BE PUT?]
  155. MAKE "DEST FIRST READLIST
  156. PR []
  157. MAKE "INTERMED (QUOTIENT 6 (:FROM * :DEST))
  158. TOWER1 :FROM :DEST :INTERMED :HEIGHT
  159. END
  160.  
  161. TO MAKPOSLIST1 :NUM :MAXNUM
  162. IF :NUM > :MAXNUM [STOP]
  163. TYPE [PLEASE POSITION THE ARM TO TOWER]
  164. TYPE CHAR 32
  165. PR :NUM
  166. MAKE "POSLIST LPUT KEYSPOS :POSLIST
  167. REPEAT 100 []
  168. MAKPOSLIST1 :NUM + 1 :MAXNUM
  169. END
  170.  
  171. TO MAKPOSLIST :NUM
  172. MAKE "POSLIST []
  173. MAKPOSLIST1 1 :NUM
  174. END
  175.  
  176. TO POSTEXT 
  177. PR []
  178. PR [USE R  OR L  KEY TO POSITION ARM]
  179. PR [USE S KEY TO MARK POSITION]
  180. PR []
  181. END
  182.  
  183. MAKE "POSLIST [123 106 87]
  184.